perm filename JUSTX.F4[NEW,LCS]3 blob
sn#706931 filedate 1983-04-13 generic text, type T, neo UTF8
C 3/19/83 ******** SUBROUTINE JUSTFY, ROOM, JSPACE *****
SUBROUTINE JUSTFY(JLP,ITEM,NPW,NO,RN,RSTFAC,R2,R4,R5)
CX SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
COPYRIGHT 1983 BY LELAND SMITH
CC COMMON/RINP/XPS(250),NP(250),NQ(400),XPR(250)
COMMON /JST/ N,XP(400),XPL(400),XPS(400),NP(400),XPR(400)
DIMENSION RN(1),NO(1),RSTFAC(0/1),NPW(1)
C DATA FOR SPACE FOR SOME ITEMS
C DATA RNT/3.0/,RST/3.0/,CLF/6.5/,BAR/1.0/,SIGL/2.5/,SIGR/1.0/
C 1,ACCI/3.0/,RLDG/2.0/,TSR/4.0/,TSL/2.0/,TTSR/6.0/,TTSL/3.0/
DATA RNT/3.6/,RST/3.0/,CLF/6.5/,BAR/1.0/,SIGL/2.5/,SIGR/1.0/
1,ACCI/2.5/,RLDG/1.6/,TSR/4.0/,TSL/2.0/,TTSR/6.0/,TTSL/3.0/
1,HALF/3.9/,WHOL/4.3/,DBW/4.8/,DOT/2.2/,SIG/2.0/,SIGN/2.0/
1,BARR/1.3/
C RNT=NOTE, RST=REST, TSR=METER RIGHT, TTSR=DBL DIGIT METER, ETC.
C RLDG=LEDGER LINE, SIGR=KEY SIG. RT, SIG=SIZE OF ACCI IN KSIG
C SIGN=SPACE FROM KSIG TO NOTE, BARR=EXTRA FOR NOTE TO RT OF BAR
C JLP= TOP STAFF NUM.
C R2=THIS STAFF NUM. R4=LEFT EDGE, R5=RIGHT EDGE.
RJLP=JLP
NN=0
C BEGIN SETUP OF NEEDED POINTERS
DO 50 K=1,ITEM
L=NPW(K)
C POINTER TO RN ARRAY
IF(R2.GT.RJLP)GO TO 55
C JUMP IF LOOKING AT ALL STAVES
IF(R2.NE.RN(L+2))GO TO 50
C SKIP IF NOT RIGHT STAFF
55 M=RN(L+1)
C CODE NUM.
IF(M.GT.4.AND.M.LT.17)GO TO 50
C LOOK AT NOTES, RESTS, CLEFS, BARS, KSIG, METER.
RL=RN(L)
C WORD COUNT
RR3=RN(L+3)
C HORIZ. POSITION
IF(RR3+0.1.LT.R4.OR.RR3.GT.R5)GO TO 50
C JUMP IF NOT IN BOUNDS
GO TO(51,52,53,54)M
C NOW CODE 17 OR 18
GO TO 59
51 IF(RN(L+9).LT.0)GO TO 50
C NEED WDCNT CHECK HERE? JUMP IF NON-IMPORTANT NOTE
59 NN=NN+1
NP(NN)=L
IF(NN.LE.250)GO TO 50
C TOO MUCH DATA?
WRITE(5,69)NN
GO TO 57
69 FORMAT(' ***** TOO MUCH. JUSTIFY LIMIT = ',I3)
52 RR6=RN(L+6)
RR7=RN(L+7)
RR8=RN(L+8)
IF(RL.GE.4.0.AND.RR6.LT.0)GO TO 50
IF(RL.GE.5.0.AND.RR7.LT.0)GO TO 50
C SKIP INVISIBILE RESTS AND RESTS WITH NEG. RHY.
IF(RL.GE.6.0.AND.RR8.NE.0)GO TO 50
C RR8<0=CENTERED WHOLE REST - ASSUMES NO NEED TO JUSTIFY.
GO TO 59
53 IF(RL.LT.3.0)GO TO 59
IF(RN(L+5).LE.4.0)GO TO 59
C FOUND TRUE CLEF (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
GO TO 50
54 IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 50
C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
GO TO 59
CC FOR REPEAT BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
50 CONTINUE
C FIRST SORT BY STAFF NUM. AND HORIZ. POS.
57 N=2
61 M=NP(N)+2
KK=N-1
JJ=NP(KK)+2
Z=RN(M)*1000.0+RN(M+1)
X=RN(JJ)*1000.0+RN(JJ+1)
IF(Z.GE.X)GO TO 62
COMPARE STAFF NUMS.*1000 + HORIZ. POS.
M=NP(N)
NP(N)=NP(KK)
NP(KK)=M
C EXCHANGE POINTERS AND TRY AGAIN
IF(N.GT.2)N=KK
GO TO 61
62 N=N+1
IF(N.LE.NN)GO TO 61
C NOW ALL SORTED BY STAFF NUM. AND POS.
XP(1)=R4
XPL(1)=0
XPR(1)=0
XPS(1)=-1.0
C SET LEFT EDGE OF JUSTIFY AREA
N=2
DO 200 K=1,NN
L=NP(K)
RL=RN(L)
C RL=WDCNT-2
RA=RN(L+1)
C RA=CODE NUM.
RR3=RN(L+3)
C RR3=POSITION(P3)
RR2=RN(L+2)
C RR2=STAFF NUM. OF THIS ITEM
RY=1.
C BASIC SIZE FACTOR
PL=0
RR5=RN(L+5)
C RR5=PARAM 5 RR6=P6 RW=P4
RR6=RN(L+6)
78 RR4=RN(L+4)
C RR4=HEIGHT-MINI(P4)
M=RA
GO TO(1,2,3,4)M
C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
IF(M.EQ.18)GO TO 18
GO TO 17
C***** NOTES ******
1 RR7=RN(L+7)
C RR7=P7 DOTS, TAILS
RC=ABS(RR4)
RR4=AMOD(RR4,100.0)
IF(RR4.GT.80.0)RR4=RR4-100.0
IF(RC.LT.80.)GO TO 19
IF(RC.LT.180.)RY=.6
C FOUND A MINI-NOTE
CC19 PL=1.
C SPACE NEEDED TO LEFT
19 PR=RNT
C SPACE NEEDED TO RIGHT (SEE DATA)
PRR=0
C STORES EXTRA SPACE TO RIGHT
PLL=0
C STORES EXTRA SPACE TO LFT
10 IF(RR7.EQ.0)GO TO 12
C TAIL ON NOTE? (CHECK FOR HALF, WHOLE NOTES, RR6<0)
RR=AMOD(RR7,10.0)
IF(RR.LE.0.OR.RR6.LT.0)GO TO 11
IF(RR5.LT.10.0.OR.RR5.GE.20.0)GO TO 11
C SKIP IF NO STEM OR STEM DOWN
PRR=1.8
C ADD ROOM FOR TAIL
11 KK=RR7/10
PX=DOT*KK
C SPACE FOR DOT(S)
PX=PX+AMOD(RR7,1.0)*10.0
C ADD SOME IF DOTS SPACED EXTRA TO RIGHT (E.G. 1.23=2.3 SPACES TO RT.)
IF(PX.GT.PRR)PRR=PX
IF(RR7.GE.10.0)GO TO 1012
C NOTE HAS DOT, NO SPACE NEEDED FOR LEDGER LINE.
IF(RR5.GE.10.0.AND.RR5.LT.20.0.AND.AMOD(RR7,10.0).GE.1.0)
1 GO TO 1012
C SKIP IF NOTE HAS TAIL ON STEM UP.
12 IF(RR4.LT.13.0.AND.RR4.GT.1.0)GO TO 1012
C IF LEDGER LINES ADD SPACE TO RIGHT
IF(PRR.GE.RLDG)GO TO 1012
C ALREADY ENOUGH SPACE FOR LEDGER LINE EXTENSION - SKIP NEXT
JJ=0
C NOW FIND NEXT CLOSEST NOTE TO RIGHT ON THIS STAFF.
X=RR4-13.0
KK=K+1
1000 IF(KK.GT.NN)GO TO 1012
J=NP(KK)
IF(RN(J+1).NE.1.0)GO TO 1012
C JUMP IF NEXT IS NOT NOTE
IF(RN(J+2).NE.RR2)GO TO 1012
C JUMP IF NOT ON SAME STAFF
IF(RN(J+3)-RR3.GT.0.1)GO TO 1003
C JUMP IF NEXT NOTE NOT SAME POS.
KK=KK+1
GO TO 1000
1003 Y=RN(J+3)
C SAVE POS OF NEXT NOTE
1006 IF(AMOD(RN(J+5),10.0).GE.1.0)GO TO 1012
C JUMP IF NEXT NOTE HAS ACCI. ENOUGH ROOM ALREADY
Z=AMOD(RN(J+4),100.0)
C HEIGHT OF NOTE
IF(X.GE.0)GO TO 1001
C JUMP IF PREV. NOTE WAS ABOVE STAFF
IF(Z.LE.1.0)GO TO 1002
C JUMP IF THIS NOTE AND LAST BELOW STAFF
GO TO 1004
1001 IF(Z.LT.13.0)GO TO 1004
1002 PRR=RLDG
C ADD SPACE TO RIGHT FOR LEDGER LINE
GO TO 1012
1004 X=RN(J+3)
IF(KK.EQ.NN)GO TO 1012
C JUMP IF NO MORE ITEMS
KK=KK+1
J=NP(KK)
IF(RN(J+2).NE.RR2)GO TO 1012
IF(RN(J+1).NE.1.0)GO TO 1012
IF(RN(J+3)-Y.LE.0.1)GO TO 1006
C GO BACK AND TRY AGAIN IF NEXT NOTE IS PART OF CHORD
1012 RR=AMOD(RR5,10.0)
C ANY ACCIDENTALS?
IF(RR.EQ.0)GO TO 13
PLL=ACCI
IF(IFIX(RR).EQ.4)PLL=ACCI+2.0
C RR=4 = DOUBLE FLAT
CCC PLL=3.0
CCC IF(IFIX(RR).EQ.4)PLL=5.0
PLL=PLL+AMOD(RR5,1.0)*10.0
C INCREASE IF ACCI. SPACED TO LEFT. (E.G. 12.21 =2.1 SPACES TO LEFT)
13 IF(ABS(RR6).LT.1.0)GO TO 14
C LOOK FOR HALF NOTES, WHOLE NOTES, NOTES ON WRONG SIDE OF STEM.
KK=0
IF(RR6.GT.0)GO TO 130
C NOW IT'S A WHITE NOTE
PR=HALF
C SEE DATA FOR SPACE FOR HALFNOTE
KK=IFIX(AMOD(RR7,10.0))
C GET RT. DIGIT IN P7
IF(KK.EQ.1)PR=WHOL
IF(KK.EQ.2)PR=DBW
C =1=WHOLENOTE, =2=DOUBLE WHOLENOTE
IF(RR6.GT.-10.0)GO TO 14
C NOW NOTE ON WRONG SIDE OF STEM
130 AR=2.5
IF(KK.EQ.1)AR=3.0
IF(KK.EQ.2)AR=3.5
IF(ABS(RR6).GE.20.0)GO TO 135
C NOW NOTE TO RIGHT OF STEM
PRR=PRR+AR
GO TO 14
135 PLL=PLL+AR
C ADD SPACE TO LEFT IF NOTE ON LEFT SIDE OF STEM
14 PR=(PR+PRR)*RY
PL=(PL+PLL)*RY
IF(RL.LT.8)GO TO 700
C JUMP IF THERE IS NOT P10 TO LOOK AT
IF(RN(L+10).EQ.0)GO TO 700
RR2=RR2+1
CC RW=RN(L+10)
C PUT P10 INTO RW
IF(RN(L+10).GE.2.0)RR2=RR2-2.
C NOW STAFF # IS SET TO WHERE NOTE REALLY IS.
GO TO 700
C***** RESTS *****
2 PR=RST
IF(RL.GE.5.0)PR=PR+RR6*2.0
C RR6=DOTS
CC PL=1.0
GO TO 700
3 IF(RL.GE.2.AND.RR4.GE.100.0)RY=.85
PR=CLF*RY
GO TO 700
C4 PL=0.5
4 PL=1.0
PR=BAR
C PL=SPACE NEEDED TO LEFT, PR=SPACE NEEDED TO RIGHT, RR3=POS. OF ITEM
KX=RR4/1000.
IF(KX.LE.0.)GO TO 40
PL=3.2
C ADD A LITTLE SPACE IN FRONT OF DBL BAR.
IF(KX.EQ.2.OR.KX.EQ.4)PR=6.0
C KX=2=DOTS TO RIGHT
IF(KX.GT.2)PL=4.2
C KX>2=DOTS TO LEFT
CC IF(RL.LT.3)GO TO 700
C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN R5.
CC229 IF(KX.NE.2)PR=PR+PR
C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
C REPT BAR WITH DOTS TO LEFT. ADD SPACE IN FRONT OF IT.
CC PL=-PL/RBX
CC IF(KX.EQ.4)KX=0
CC129 IF(KX.GE.2)PL=RBZ*PL
C IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
GO TO 42
40 Z=999.
C FIND NEXT CLOSEST ITEM.
DO 41 M=1,NN
J=NP(M)
IF(R2.LE.RJLP.AND.R2.NE.RN(J+2))GO TO 41
C SKIP IF NOT ON RIGHT STAFF
X=RN(J+3)
IF(X.GT.Z.OR.X.LE.RR3)GO TO 41
Z=RR3
L=J
C SAVE POS. AND CODE NUM.
41 CONTINUE
IF(RN(L+1).LE.2.0)PR=PR+BARR
C IF A NOTE OR REST, ADD 1.5 TO SPACE
42 RR4=AMOD(RR4,100.0)
C FIND HOW MANY STAVES UP THE BAR GOES
IF(RR4.EQ.0)RR4=1.0
RR4=RR4+RR2
43 CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
RR2=RR2+1.0
C RESERVE SPACE FOR BAR LINE ON EVERY STAFF COVERED.
IF(RR2.LT.RR4)GO TO 43
GO TO 200
C KSIG
17 RR5=ABS(RR5)
IF(RR5.GE.100)RR5=RR5-100
C +100 FOR NATURALS AS KEYSIG.
PR=SIGR+SIG*(RR5-1)
C SPACES FOR CORRECT NUM OF ACCIS. RR5=NUM OF ACCIS.
PL=SIGL
IF(K+1.GT.NN)GO TO 700
C WHAT FOLLOWS KSIG?
KK=NP(K+1)
IF(RN(KK+2).NE.RR2)GO TO 700
IF(RN(KK+1).LE.2.0)PR=PR+SIGN
C FIND NOTE OR REST ADD VALUE OF SIG_N TO PR
GO TO 700
C METER
18 RC=0
IF(RL.GE.7)RC=9
C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
PR=TSR
PL=TSL
IF(RR6.LE.9.AND.RR5.LE.9)GO TO 180
C CHECKS FOR 2-DIGIT METERS
PR=TTSR
PL=TTSL
180 PR=PR+RC
700 CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
200 CONTINUE
CALL JSPACE(NO,R2,R4,R5,RN)
300 END
SUBROUTINE ROOM(RB,RL,RR,STAF,R4,R5,RSTFAC)
C SETS UP ARRAYS CONTAINING ALL NEEDED SPACE INFO
COMMON /JST/ N,P(400),PL(400),PS(400),NP(400),PR(400)
CC COMMON/RINP/PS(250),NP(250),NQ(400),PR(250)
CC COMMON /JST/ N,P(250),PL(250)
C SHARE THESE ARRAYS WITH SOME OTHERS??? (RINP?)
DIMENSION RSTFAC(0/1)
P(N)=0
PL(N)=0
PR(N)=0
PS(N)=-1
C ZERO OUT NEXT ARRAY SLOTS
IF(ABS(RB-R4).LE.0.1)RL=0
IF(ABS(RB-R5).LE.0.1)RR=0
CHECK TO SEE IF ITEM IS AT LEFT OR RIGHT EDGE OF JUSTIFY AREA.
K=STAF
S=RSTFAC(K)
C GET PROPER SIZE FACTOR FOR THIS STAFF
RL=RL*S
RR=RR*S
DO 1 K=1,N-1
IF(ABS(RB-P(K)).GT.0.1)GO TO 1
C SAME POSITION?
IF(RB.LT.P(K))P(K)=RB
C USE POSITION FARTHEST TO LEFT
IF(STAF.NE.PS(K))GO TO 1
C SAME STAFF?
IF(PR(K).LT.RR)PR(K)=RR
IF(PL(K).LT.RL)PL(K)=RL
C ITEM IN SAME POS. CHANGE SPACE REQUIREMENTS IF NECESSARY.
RETURN
1 CONTINUE
P(N)=RB
PR(N)=RR
PL(N)=RL
PS(N)=STAF
N=N+1
C PUT AWAY MORE SPACE NEEDS.
END
SUBROUTINE JSPACE(NO,R2,R4,R5,RN)
DIMENSION NO(1),RN(1)
COMMON /JST/ N,P(400),PL(400),PS(400),NP(400),PR(400)
CC COMMON/RINP/PS(250),NP(250),NQ(400),PR(250)
CC COMMON /JST/ N,P(250),PL(250)
CC P(N)=R5
CC PR(N)=0
CC PL(N)=0
P(N)=9999.
C LAST POINT IS RIGHT LIMIT OF JUSTIFY AREA
CC P(N+1)=9999.
N=N-1
K=1
2 A=P(K)
M=K+1
KK=K
DO 1 L=M,N
B=ABS(P(L)-A)
IF(B.GT.0.1)GO TO 6
P(L)=A
C SAME POS.
GO TO 1
6 IF(P(L).GT.A)GO TO 1
C FIND ITEM FURTHEST TO LEFT
A=P(L)
K=L
1 CONTINUE
10 IF(K.EQ.KK)GO TO 3
B=PR(K)
C=PL(K)
D=PS(K)
DO 4 L=K,KK+1,-1
C SHUFFLE ARRAYS
LL=L-1
P(L)=P(LL)
PL(L)=PL(LL)
PR(L)=PR(LL)
4 PS(L)=PS(LL)
11 P(KK)=A
PR(KK)=B
PL(KK)=C
PS(KK)=D
3 K=KK+1
IF(K.LE.N)GO TO 2
C NOW COLLECT ALL SPACE IN PL ARRAY
DO 20 K=2,N+1
L=K-1
IF(PS(K).NE.PS(L))GO TO 21
C SAME STAFF?
GO TO 23
21 L=K-2
22 IF(PS(L).EQ.PS(K))GO TO 23
L=L-1
IF(L.GT.0)GO TO 22
GO TO 20
23 PL(K)=PL(K)+PR(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
20 CONTINUE
C NOW STORE POS OF EACH PREV. ITEM ON SAME STAFF IN PR ARRAY.
DO 40 K=2,N+1
L=K-1
IF(PS(K).NE.PS(L))GO TO 41
C SAME STAFF?
GO TO 43
41 L=K-2
42 IF(L.LE.0)GO TO 44
IF(PS(L).EQ.PS(K))GO TO 43
L=L-1
IF(L.GT.0)GO TO 42
44 PR(K)=R4
C FAR LEFT POS. OF JUST. RANGE GOES INTO PR
7 GO TO 40
43 PR(K)=P(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
C STORE POS. OF PREVIOUS ITEM IN PR ARRAY.
40 CONTINUE
PR(1)=R4
C NOW GET RID OF UNNEEDED DATA
L=2
30 LL=L-1
IF(P(L).NE.P(LL))GO TO 36
C NOW 2 ITEMS IN SAME POS. ON DIFF. STAVES
IF(PR(L).EQ.PR(LL))GO TO 34
C JUMP IF POS. OF PREV. ITEM IS SAME IN BOTH CASES.
A=P(L)-PR(L)-PL(L)
B=P(LL)-PR(LL)-PL(LL)
C A,B = EXCESS SPACE AVAILABLE., KEEP THE ONE WITH THE LEAST.
IF(B.GT.A)L=L-1
GO TO 35
34 IF(PL(L).GT.PL(LL))PL(LL)=PL(L)
C EXCHANGE IF NEEDED SPACE HERE IS < PREVIOUS NEEDED
35 N=N-1
C DECREMENT COUNTER
33 DO 32 K=L,N
C CONTRACT ARRAY
M=K+1
PL(K)=PL(M)
PR(K)=PR(M)
32 P(K)=P(M)
GO TO 9
36 L=L+1
9 IF(L.LE.N)GO TO 30
100 DO 101 K=1,N
101 PS(K)=P(K)
C PS WILL HOLD SHIFTED POINTS
99 FORMAT('+',I2,1X,$)
98 FORMAT(' ',$)
TYPE 98
DO 50 J=1,40
C "ACCORDIAN" LOOP - USUALLY EXITS WELL BEFORE 40
Y=0
TYPE 99,J
DO 51 K=2,N
A=PS(K)-PR(K)-PL(K)
C NEG. MOVE REQUIREMENT
IF(A.GE.-0.1)GO TO 51
C SKIP IF ENOUGH SPACE
Y=PS(K)
C SHIFT ALL POINTS FOUND FROM HERE TO FAR RIGHT
DO 52 L=K,N
PS(L)=PS(L)-A
52 IF(PR(L).GE.Y)PR(L)=PR(L)-A
IF(PR(K).EQ.PS(K-1))GO TO 51
C JUMP IF PREVIOUS ITEM ON SAME STAFF
C NOW SHIFT OTHER STAVES' ITEMS FOUND TO LEFT
Z=PR(K)
F=Y-PR(K)
C LOOK IN AREA BOUNDED BY Z AND Y
F=(Y-Z-A)/(Y-Z)
C SPACING FACTOR
DO 53 L=1,N
B=PS(L)
IF(B.LT.Z.OR.B.GT.Y)GO TO 54
C FOUND A POINT TO SHIFT
B=B-Z
C ACTUAL SPACE FROM LEFT LIMIT
PS(L)=Z+B*F
C LEFT LIMIT+SPACE*FACTOR
54 B=PR(L)
IF(B.LT.Z.OR.B.GT.Y)GO TO 53
B=B-Z
PR(L)=Z+B*F
53 CONTINUE
51 CONTINUE
IF(PS(N).LE.R5)GO TO 203
C MORE THAN ENOUGH SPACE EXISTS
IF(Y.EQ.0)GO TO 203
C JUMP OUT IF NO POINTS MOVED
F=(R5-R4)/(PS(N)-R4)
C FACTOR TO SHIFT ALL BACK WITHIN ORIGINAL LIMITS
Z=R4-R4*F
DO 56 K=1,N
PS(K)=Z+PS(K)*F
56 PR(K)=Z+PR(K)*F
CC PS(K)=R4+(PS(K)-R4)*F
CC56 PR(K)=R4+(PR(K)-R4)*F
50 CONTINUE
CQ NEXT WAS ATTEMPT TO REPLACE "ACCORDIAN" SYSTEM 3/83 (LABELS 101+1→50)
CQ GO TO 203
CQ DIMENSION PSX(300),PRR(300),PG(300)
C GET NUM OF STAFF TO JUSTIFY
CQ DO 60 K=1,N
C SAVE ALL DATA
CQ PSX(K)=PS(K)
CQ PRR(K)=PR(K)
CQ60 PG(K)=PS(K)-PR(K)-PL(K)
C PG ARRAY HAS VALUE OF ALL GAPS.
CQ J=0
CQ61 T=0
C T=TOTAL GAP SPACE AVAILABLE
CQ DO 62 K=1,N
CQ IF(PG(K).LE.0)GO TO 62
C SKIP IF NO GAP IN FRONT OF THIS ITEM
CQ A=PR(K)
C POS. OF PREVIOUS ITEM ON THAT STAFF
CQ B=PS(K)
C POS OF THIS ITEM
CQ G=PG(K)
C ADJUSTED GAP SIZE AVAILABLE
CQ IF(R2.LT.RJLP)GO TO 66
CQ GG=0
CQ DO 63 L=K+1,N
C CHECK FOR K+1 > N
CQ IF(PS(L).LE.A.OR.PR(L).GE.B)GO TO 63
C JUMP IF ITEM IS TO LEFT OF ITEM K OR PREV. IS TO RIGHT
CQ IF(PG(L).LE.0)GO TO 63
C JUMP IF NO GAP HERE
CQ GG=PG(L)
CQ IF(PS(L)-GG.LT.PS(L-1))GG=PS(L)-PS(L-1)
C GAP CAN BE NO GREATER THAN DIST TO PREV. ITEM ON OTHER STAFF
CQ IF(GG.LT.G)G=GG
C FIND SMALLEST GAP
CQ63 CONTINUE
CQ IF(GG.EQ.0)GO TO 62
C JUMP IF NO GAPS WITHIN PROPER BOUNDS ARE FOUND
CQ66 T=T+G
C ADD UP TOTAL GAP SPACE
CQ DO 64 L=K,N
C NOW SHIFT ALL ITEMS TO LEFT TO FILL IN SMALLEST GAP
CQ PS(L)=PS(L)-G
CQ IF(PR(L).GE.B)GO TO 65
C SKIP IF PREV. ITEM IS OUT OF BOUNDS TO RIGHT
CQ PG(L)=PG(L)-G
C DECREASE THE GAP SIZES
CQ GO TO 64
CQ65 PR(L)=PR(L)-G
C MOVE BACK POS. OF PREV. ITEM IF IN BOUNDS
CQ64 CONTINUE
CQ62 CONTINUE
CQ IF(J.NE.0)GO TO 203
C J=-1 SECOND TIME THROUGH LOOP.
CQ IF(T.EQ.0)GO TO 70
C JUMP IF NO FREE SPACE WAS FOUND
CQ X=(PSX(N)-R5)/T
C EXTRA SPACE REDUCTION FACTOR
CQ IF(X.LT.1.0)GO TO 71
C JUMP IF NOT ENOUGH ROOM WAS FOUND, USE PS AS IS.
CQ70 X=(R5-R4)/(PS(N)-R4)
C SHIFT ALL POINTS BY THIS FACTOR
CQ DO 75 L=1,N
CQ PS(L)=R4+(PS(L)-R4)*X
CQ75 PR(L)=R4+(PR(L)-R4)*X
CQ GO TO 203
CQ71 DO 72 L=1,N
C GET BACK ORIGINAL DATA AND GO THRU LOOP AGAIN WITH FACTOR
CQ PS(L)=PSX(L)
CQ PR(L)=PRR(L)
CQ72 PG(L)=(PS(L)-PR(L)-PL(L))*X
CQ J=-1
CQ GO TO 61
C NOW PS(1) SHOULD BE >=R4, PS(N)<=R5.
203 CALL MOVIT(RN,NO,0.0,2000.0,1000.0,0.0)
C MOVE EVERYTHING 1000 TO RIGHT
CCC203 CALL MOVIT(RN,NO,R5,2000.0,1000.0,0.0)
C MOVE ANYTHING TO RIGHT OF JUSTIFY AREA FAR TO RIGHT.
CC CAN'T USE DO LOOP, FAIL PROG. WIPES OUT AC15. DO 206 K=1,N
CC CALL MOVIT(RN,NO,R4,R5,500.0,0.0)
C NOW MOVE JUSTIFY AREA 500 TO RIGHT. LEAVES ROOM FOR EXPANSION, CONTRACTION.
K=2
L=1
C A= AMOUNT MOVED LEFT OR RIGHT.
206 CALL MOVIT(RN,NO,P(L)+1000.0,P(K)+1000.0,PS(L),PS(K))
C MOVE OLD RANGE INTO NEW RANGE (AND SHIFT BACK 1000)
L=K
K=K+1
IF(K.LE.N)GO TO 206
CALL MOVIT(RN,NO,1000.0,3000.0,-1000.0,0.0)
CCC CALL MOVIT(RN,NO,R5+1000.0,3000.0,-1000.0,0.0)
C MOVE BACK THINGS TO RIGHT OF JUSTIFY AREA. NOW ALL DONE.
300 END